home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / mididemo / midi.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-05-02  |  29.5 KB  |  825 lines

  1. VERSION 2.00
  2. Begin Form MidiPlayer 
  3.    BackColor       =   &H00FFFFFF&
  4.    Caption         =   "Midi Demo"
  5.    ClientHeight    =   5460
  6.    ClientLeft      =   1560
  7.    ClientTop       =   2175
  8.    ClientWidth     =   6300
  9.    ClipControls    =   0   'False
  10.    ForeColor       =   &H00C00000&
  11.    Height          =   6150
  12.    KeyPreview      =   -1  'True
  13.    Left            =   1500
  14.    LinkTopic       =   "Form1"
  15.    MaxButton       =   0   'False
  16.    ScaleHeight     =   5460
  17.    ScaleWidth      =   6300
  18.    Top             =   1545
  19.    Width           =   6420
  20.    Begin CommandButton BTN_ClearList 
  21.       Caption         =   "&Clear"
  22.       Height          =   400
  23.       Left            =   2400
  24.       TabIndex        =   14
  25.       Top             =   3500
  26.       Width           =   1000
  27.    End
  28.    Begin CommandButton BTN_QueueAll 
  29.       Caption         =   "Queue &All"
  30.       Height          =   400
  31.       Left            =   2400
  32.       TabIndex        =   13
  33.       Top             =   2900
  34.       Width           =   1000
  35.    End
  36.    Begin CommandButton BTN_Queue 
  37.       Caption         =   "&Queue"
  38.       Height          =   400
  39.       Left            =   2400
  40.       TabIndex        =   12
  41.       Top             =   2300
  42.       Width           =   1000
  43.    End
  44.    Begin ListBox PlayList 
  45.       Height          =   4710
  46.       Left            =   3795
  47.       TabIndex        =   5
  48.       Top             =   500
  49.       Width           =   2370
  50.    End
  51.    Begin FileListBox File1 
  52.       Height          =   3345
  53.       Left            =   100
  54.       MultiSelect     =   2  'Extended
  55.       TabIndex        =   11
  56.       Top             =   1875
  57.       Width           =   1800
  58.    End
  59.    Begin DirListBox Dir1 
  60.       Height          =   930
  61.       Left            =   100
  62.       TabIndex        =   10
  63.       Top             =   870
  64.       Width           =   1800
  65.    End
  66.    Begin DriveListBox Drive1 
  67.       Height          =   315
  68.       Left            =   100
  69.       TabIndex        =   9
  70.       Top             =   500
  71.       Width           =   1800
  72.    End
  73.    Begin CommandButton BTN_Pause 
  74.       Caption         =   "Pa&use"
  75.       Height          =   400
  76.       Left            =   2400
  77.       TabIndex        =   2
  78.       Top             =   1700
  79.       Width           =   1000
  80.    End
  81.    Begin CommandButton BTN_Exit 
  82.       Caption         =   "&Exit"
  83.       Height          =   400
  84.       Left            =   2400
  85.       TabIndex        =   4
  86.       Top             =   4700
  87.       Width           =   1000
  88.    End
  89.    Begin CommandButton BTN_Stop 
  90.       Caption         =   "&Stop"
  91.       Height          =   400
  92.       Left            =   2400
  93.       TabIndex        =   3
  94.       Top             =   4100
  95.       Width           =   1000
  96.    End
  97.    Begin CommandButton BTN_Next 
  98.       Caption         =   "&Next"
  99.       Height          =   400
  100.       Left            =   2400
  101.       TabIndex        =   1
  102.       Top             =   1100
  103.       Width           =   1000
  104.    End
  105.    Begin CommandButton BTN_Play 
  106.       Caption         =   "&Play"
  107.       Height          =   400
  108.       Left            =   2400
  109.       TabIndex        =   0
  110.       Top             =   500
  111.       Width           =   1000
  112.    End
  113.    Begin Label Label1 
  114.       Caption         =   "Total Time:"
  115.       Height          =   225
  116.       Left            =   100
  117.       TabIndex        =   6
  118.       Top             =   210
  119.       Width           =   2100
  120.    End
  121.    Begin Label Label3 
  122.       Caption         =   "Elapsed Time:"
  123.       Height          =   225
  124.       Left            =   3765
  125.       TabIndex        =   8
  126.       Top             =   210
  127.       Width           =   1245
  128.    End
  129.    Begin Label lblElapsedTime 
  130.       Caption         =   "00:00"
  131.       Height          =   225
  132.       Left            =   5025
  133.       TabIndex        =   7
  134.       Top             =   210
  135.       Width           =   630
  136.    End
  137.    Begin Menu MNU_File 
  138.       Caption         =   "&File"
  139.       Begin Menu MNU_MidiMap 
  140.          Caption         =   "&Run Midi Mapper"
  141.       End
  142.       Begin Menu Separator2 
  143.          Caption         =   "-"
  144.       End
  145.       Begin Menu MNU_Exit 
  146.          Caption         =   "&Exit"
  147.       End
  148.    End
  149.    Begin Menu MNU_About 
  150.       Caption         =   "&About"
  151.    End
  152. ' Disclaimer of Warranty:
  153. ' This software and the accompanying files are provided "as is"
  154. ' and without warranties as to performance of the software and
  155. ' the accompanying files or any other warranties whether expressed
  156. ' or implied.  No warranty of fitness for a particular purpose
  157. ' is offered.
  158. ' You may not sell this software or it's source code.
  159. ' You may use this code in any way you find useful.
  160. Declare Function mciSendString Lib "mmsystem" (ByVal lpstrCommand$, ByVal lpstrReturnStr As Any, ByVal wReturnLen%, ByVal hCallBack%) As Long
  161. Declare Function mciGetErrorString Lib "mmsystem" (ByVal dwError As Long, ByVal lpstrBuffer As Any, ByVal wLength As Integer) As Integer
  162. Declare Function GetModuleUsage% Lib "Kernel" (ByVal hModule%)
  163. Option Base 1       'Set arrays to use a base of 1
  164. Dim SongPath() As String    'array to store path and file name of the midi file
  165. Dim NumSongsQueued As Integer  'Total number of songs queued in the Play List
  166. Dim Number As Integer       'The song that is currently playing
  167. Dim TotalTime As String     'Playing time of all queued songs in format "(HH:MM:SS)"
  168. Dim TTime As Single         'Playing time of all queued songs for calculations
  169. 'Flags
  170. 'All flags are either true or false
  171. Dim StopPlayback, PausePlayback, NextSong As Integer 'Flags for controlling playback
  172. Dim SongPlaying As Integer  'Flag to let the whole program know whenever a song is playing
  173. Dim UnPaused As Integer     'Flag for indicating when a song has been paused and then started again
  174. Sub BTN_ClearList_Click ()
  175.     'Remove each item in the Play List
  176.     If PlayList.ListCount > 0 Then
  177.         For I = 0 To PlayList.ListCount - 1
  178.             PlayList.RemoveItem 0
  179.         Next
  180.     End If
  181.     'Start with "clean" array
  182.     Erase SongPath
  183.     'Reset variables
  184.     NumSongsQueued = 0
  185.     TTime = 0
  186.     TotalTime = "00:00:00"
  187.     label1.Caption = "Total Time: " + TotalTime
  188.     BTN_Play.Enabled = False
  189. End Sub
  190. Sub BTN_Exit_Click ()
  191.     Unload MidiPlayer
  192. End Sub
  193. Sub BTN_Next_Click ()
  194.     'This routine will stop playback of the current song and
  195.     'and skip to either the next song in the list, or jump
  196.     'to any song which the user highlights in the play list.
  197.     Dim Ret, ErrorRet As Integer
  198.     Dim mciErrorText As String
  199.     Dim mciBuffer As Integer
  200.     mciBuffer = 255
  201.     mciErrorText = Space(255)
  202.     'Set NextSong flag to true
  203.     NextSong = True
  204.     'Close the song that is playing.
  205.     'This automatically stops playback
  206.     Ret = mciSendString("close all", 0&, 0, 0)
  207.     If Ret <> 0 Then GoTo mciError3
  208.             
  209.     'If the song highlighted in the Play List is not
  210.     'the song that is currently playing then
  211.     'set Number in the For..Next loop in BTN_Play_Click event
  212.     'to the selected song in the Play List
  213.     If PlayList.ListIndex <> Number - 1 Then
  214.         Number = PlayList.ListIndex
  215.     End If
  216.     Exit Sub
  217. mciError3:
  218.     ErrorRet = mciGetErrorString(Ret, mciErrorText, mciBuffer)
  219.     If ErrorRet = 1 Then
  220.         Msg$ = mciErrorText
  221.         MsgBox Msg$, 48, "Midi Error"
  222.     Else
  223.         MsgBox "An unknown error occured", 16, "Error"
  224.     End If
  225.     Ret = mciSendString("close all", 0&, 0, 0)
  226. End Sub
  227. Sub BTN_Pause_Click ()
  228.     Dim Ret, ErrorRet As Integer
  229.     Dim mciErrorText As String
  230.     Dim mciBuffer As Integer
  231.     mciBuffer = 255
  232.     mciErrorText = Space(255)
  233.     UnPaused = False
  234.     If LCase$(Left$(BTN_Pause.Caption, 2)) = "pa" Then
  235.         BTN_Pause.Caption = "Res&ume"
  236.         'Pause playback of the song
  237.         Ret = mciSendString("pause MidiFile", 0&, 0, 0)
  238.         If Ret <> 0 Then GoTo mciError1
  239.     ElseIf LCase$(Left$(BTN_Pause.Caption, 2)) = "re" Then
  240.         BTN_Pause.Caption = "Pa&use"
  241.         Ret = mciSendString("play MidiFile", 0&, 0, 0)
  242.         If Ret <> 0 Then GoTo mciError1
  243.         'The MCI sequencer doesn't support the RESUME command.
  244.         'The PLAY command will work fine, but the STATUS MODE command
  245.         'will still return PAUSED rather than STOPPED.  Therefore,
  246.         'the program must be informed of this another way.
  247.         UnPaused = True
  248.     End If
  249.     Exit Sub
  250. mciError1:
  251.     ErrorRet = mciGetErrorString(Ret, mciErrorText, mciBuffer)
  252.     If ErrorRet = 1 Then
  253.         Msg$ = mciErrorText
  254.         MsgBox Msg$, 48, "Midi Error"
  255.     Else
  256.         MsgBox "An unknown error occured", 16, "Error"
  257.     End If
  258.     Ret = mciSendString("close all", 0&, 0, 0)
  259. End Sub
  260. Sub BTN_Play_Click ()
  261.     Dim Ret, ErrorRet As Integer
  262.     Dim mciErrorText As String
  263.     Dim mciBuffer As Integer
  264.     Dim PlayDone As Integer, Start As Integer
  265.     mciBuffer = 255
  266.     mciErrorText = Space(255)
  267.     Start = PlayList.ListIndex + 1
  268.     'If Play is pressed and nothing is selected in the Play List,
  269.     'Start will be 0 (because PlayList.ListIndex = -1), so it is
  270.     'necessary to set Start = 1.
  271.     If Start = 0 Then
  272.         Start = 1
  273.     End If
  274.     For Number = Start To NumSongsQueued
  275.             
  276.         StopPlayback = False
  277.         'PausePlayback = False
  278.         NextSong = False
  279.         PlayDone = False
  280.         'NewSong = True
  281.         'This line opens the sequencer with the specified file.
  282.         Ret = mciSendString("open " + SongPath(Number) + " type sequencer alias MidiFile", 0&, 0, 0)
  283.         'mciSendString always returns 0 if successful.  Any other value indicates
  284.         'that an error occcured.
  285.         If Ret <> 0 Then GoTo mciError
  286.               
  287.         'This lines plays the file specified in the open command
  288.         Ret = mciSendString("play MidiFile", 0&, 0, 0)
  289.         If Ret <> 0 Then GoTo mciError
  290.               
  291.         'Highlight the song that is currently playing
  292.         PlayList.Selected(Number - 1) = True
  293.         SongPlaying = True
  294.                 
  295.         'Change the enabled property of all buttons and the menu item to start midi mapper
  296.         BTN_Play.Enabled = False
  297.         BTN_Next.Enabled = True
  298.         BTN_Pause.Enabled = True
  299.         BTN_Stop.Enabled = True
  300.         BTN_Queue.Enabled = False
  301.         BTN_QueueAll.Enabled = False
  302.         MNU_MidiMap.Enabled = False
  303.         BTN_ClearList.Enabled = False
  304.               
  305.         MLen% = 255
  306.         Msg$ = String$(255, 0)
  307.                
  308.         'Set the proper time format
  309.         Stat$ = "set MidiFile time format smpte 30 drop"
  310.         Ret = mciSendString(Stat$, Msg$, MLen%, MidiPlayer.hWnd)
  311.               
  312.         'Execute the following DO loop while the song is playing
  313.         'When the msg$ "stopped" is returned, exit the loop.
  314.         'Also exit the loop if the Next or Stop button are pressed
  315.         'This loop is used to yield control to Windows while a song is playing
  316.         'It also returns the status of the song and the elapsed time.
  317.                     
  318.         Do Until StopPlayback Or NextSong Or PlayDone
  319.         'A slower computer will obviously execute this loop less often.
  320.         'The only effect this should have is that the elapsed time
  321.         'will be updated less frequently causing the seconds to skip
  322.         'some increments.  This probably would only happen on a 386
  323.         'computer.
  324.             'Sending Stat$ will return the status (playing, stopped, paused)
  325.             Stat$ = "status MidiFile mode"
  326.                   
  327.             'In order for these functions to work properly,
  328.             'Msg$ and MMErr$ must be a fixed-length strings
  329.             Ret = mciSendString(Stat$, Msg$, MLen%, MidiPlayer.hWnd)
  330.                 
  331.             'If the playback had been paused, MCI sequencer will still
  332.             'return PAUSED instead of STOPPED after the song has finished.
  333.             'Therefore this must be checked another way.
  334.             If InStr(Msg$, "stopped") Or (InStr(Msg$, "paused") And UnPaused) Then
  335.                 PlayDone = True
  336.                 UnPaused = False
  337.             End If
  338.                    
  339.             'Send Stat$ to return the elapsed time
  340.             Stat$ = "status MidiFile position"
  341.             Ret = mciSendString(Stat$, Msg$, MLen%, MidiPlayer.hWnd)
  342.                
  343.             lblElapsedTime.Caption = Mid$(Msg$, 4, 5)
  344.                    
  345.             'Yield control to Windows
  346.             DoEvents
  347.         Loop
  348.         If Not NextSong Then
  349.             'Close midi file and sequencer device
  350.             Ret = mciSendString("close all", 0&, 0, 0)
  351.             If Ret <> 0 Then GoTo mciError
  352.         End If
  353.                 
  354.         'If MNU_Reset.Checked Then
  355.         '    MidiReset
  356.         'End If
  357.                 
  358.         'StopPlayback is only true if the Stop button was clicked
  359.         If StopPlayback Then Exit For
  360.     Next Number
  361.         
  362.     'When the For..Next loop completes normally, Number is going
  363.     'to be incremented to one higher than what the array is dimensioned for.
  364.     'Therefore, reset Number to the # of queued songs.
  365.     If Number > NumSongsQueued Then
  366.         Number = NumSongsQueued
  367.         PlayList.Selected(Number - 1) = False
  368.     End If
  369.     BTN_Play.Enabled = True
  370.     BTN_Next.Enabled = False
  371.     BTN_Pause.Enabled = False
  372.     BTN_Stop.Enabled = False
  373.     BTN_Queue.Enabled = True
  374.     BTN_QueueAll.Enabled = True
  375.     MNU_MidiMap.Enabled = True
  376.     BTN_Exit.Enabled = True
  377.     BTN_ClearList.Enabled = True
  378.     SongPlaying = False
  379.     Screen.MousePointer = 0
  380.     Exit Sub
  381. mciError:
  382.     Screen.MousePointer = 0
  383.     ErrorRet = mciGetErrorString(Ret, mciErrorText, mciBuffer)
  384.     If ErrorRet = 1 Then
  385.         Msg$ = mciErrorText
  386.         MsgBox Msg$, 48, "Midi Error"
  387.     Else
  388.         MsgBox "An unknown error occured", 16, "Error"
  389.     End If
  390.     Ret = mciSendString("close all", 0&, 0, 0)
  391. End Sub
  392. Sub BTN_Queue_Click ()
  393.     Screen.MousePointer = 11
  394.     For I = 0 To File1.ListCount - 1
  395.         If File1.Selected(I) Then
  396.             
  397.             File1.Selected(I) = False
  398.             'Increment the number of queued songs and redim the arrays
  399.             NumSongsQueued = NumSongsQueued + 1
  400.             ReDim Preserve SongPath(NumSongsQueued)
  401.             
  402.             SongPath(NumSongsQueued) = File1.Path + "\" + File1.List(I)
  403.             SongFileName = File1.List(I)
  404.             If IsSongQueued(SongPath(NumSongsQueued)) Then
  405.                 Msg$ = SongPath(NumSongsQueued) + CRLF
  406.                 Msg$ = Msg$ + "This song is already in the Play List." + CRLF
  407.                 Msg$ = Msg$ + "Do you want to queue it again?"
  408.                 Ans% = MsgBox(Msg$, 36)
  409.                 If Ans% = 7 Then
  410.                     NumSongsQueued = NumSongsQueued - 1
  411.                     ReDim Preserve SongPath(NumSongsQueued)
  412.                     GoTo NextSong
  413.                 End If
  414.             End If
  415.             GetTime SongPath(NumSongsQueued)
  416.             'Add the song to the Play List
  417.             PlayList.AddItem SongFileName + " (" + SongLength + ")"
  418.             
  419.             'Scroll the list of songs, un-select it, and update the total time label
  420.             PlayList.ListIndex = NumSongsQueued - 1
  421.             PlayList.Selected(PlayList.ListIndex) = False
  422.             label1.Caption = "Total Time: " + TotalTime
  423.         End If
  424. NextSong:
  425.     Next I
  426.     If PlayList.ListCount <> 0 Then
  427.         BTN_Play.Enabled = True
  428.     End If
  429.     Screen.MousePointer = 0
  430. End Sub
  431. Sub BTN_QueueAll_Click ()
  432.     ReDim SongPath(1)
  433.     'If any songs are already queued, clear the Play List
  434.     If PlayList.ListCount > 0 Then
  435.         BTN_ClearList_Click
  436.     End If
  437.     Screen.MousePointer = 11
  438.     For I = 0 To File1.ListCount - 1
  439.         NumSongsQueued = NumSongsQueued + 1
  440.         ReDim Preserve SongPath(NumSongsQueued)
  441.         SongPath(NumSongsQueued) = File1.Path + "\" + File1.List(I)
  442.         SongFileName = File1.List(I)
  443.         
  444.         Song$ = SongPath(NumSongsQueued)
  445.         Call GetTime(Song$)
  446.         label1.Caption = "Total Time: " + TotalTime
  447.         
  448.         PlayList.AddItem SongFileName + " (" + SongLength + ")"
  449.         PlayList.ListIndex = NumSongsQueued - 1
  450.         PlayList.Selected(PlayList.ListIndex) = False
  451.     Next I
  452.     If PlayList.ListCount <> 0 Then
  453.         BTN_Play.Enabled = True
  454.     End If
  455.     Screen.MousePointer = 0
  456. End Sub
  457. Sub BTN_Stop_Click ()
  458.     Screen.MousePointer = 11
  459.     Ret = mciSendString("stop MidiFile", 0&, 0, 0)
  460.     StopPlayback = True
  461.     DoEvents
  462.     SongPlaying = False
  463.     Ret = mciSendString("Close All", 0&, 0, 0)
  464. End Sub
  465. Function CanPlay ()
  466.     'This function determines if the MCIsequencer and MidiMapper
  467.     'are installed on a system by attempting to open the sequencer
  468.     'and checking the SYSTEM.INI file.
  469.     'Returns 0 if all is well
  470.     'Returns 1 if mcisequencer not installed
  471.     'Returns 2 if Midi Mapper not installed
  472.     'Returns 3 of NEITHER device is installed
  473.     Dim Ret, ErrorRet, RetVal As Integer
  474.     Dim mciErrorText As String * 255
  475.     Dim mciBuffer As Integer
  476.     mciBuffer = 255
  477.     'mciErrorText = Space(255)
  478.     Dim WinDir1 As String * 128
  479.     Dim WinDirSize As Integer
  480.     WinDirSize = 128
  481.     Dim Mapper As String * 128
  482.     Dim MapperSize As Integer
  483.     MapperSize = 128
  484.     CanPlay = False
  485.     Ret = mciSendString("open sequencer", 0&, 0, 0)
  486.     'If the OPEN failed, set function return value to 1
  487.     'A variable must be used and then the value of that variable
  488.     'assigned to the function's return value, otherwise, the function
  489.     'could be called recursively.
  490.     If Ret <> 0 Then
  491.         RetVal = 1
  492.     End If
  493.     'Use the line below if the mciSendString function was unsuccessful
  494.     'and you want to get the associated error message.  This is not
  495.     'neccessary in this routine.
  496.     'If Ret <> 0 Then GoTo mciError2
  497.     'Need to get the Windows directory
  498.     Ret = GetWindowsDirectory(WinDir1, WinDirSize)
  499.     WinDir = LCase(Left$(WinDir1, Ret))
  500.     SysIniFilePath = WinDir + "\system.ini"
  501.     'Since the sequencer will open properly even if Midi Mapper is not installed,
  502.     'check for this in the system.ini file
  503.     a% = GetPrivateProfileString("Drivers", "MidiMapper", "None", Mapper, MapperSize, SysIniFilePath)
  504.     'If there is no line for the Midi Mapper in system.ini,
  505.     'add 2 to return value
  506.     If InStr(Mapper, "None") Then
  507.     'This is where the function would be recursive if a variable
  508.     'were not used.
  509.         RetVal = RetVal + 2
  510.     End If
  511.     'Close the sequencer
  512.     Ret = mciSendString("close all", 0&, 0, 0)
  513.     CanPlay = RetVal
  514.     Exit Function
  515. mciError2:
  516.     ErrorRet = mciGetErrorString(Ret, mciErrorText, mciBuffer)
  517.     If ErrorRet = 1 Then
  518.         Msg$ = mciErrorText
  519.         MsgBox Msg$, 48, "Midi Error"
  520.     Else
  521.         MsgBox "An unknown error occured", 16, "Error"
  522.     End If
  523.     Ret = mciSendString("close all", 0&, 0, 0)
  524.     BTN_Stop_Click
  525. End Function
  526. Sub Dir1_Change ()
  527.     File1.Path = Dir1.Path
  528. End Sub
  529. Sub Drive1_Change ()
  530.     Dir1.Path = Drive1.Drive
  531. End Sub
  532. Sub File1_DblClick ()
  533.     BTN_Queue_Click
  534. End Sub
  535. Sub File1_KeyPress (KeyAscii As Integer)
  536.     If KeyAscii = 13 Then BTN_Queue_Click
  537. End Sub
  538. Sub Form_Load ()
  539.     'Center the window on the desktop
  540.     Move (Screen.Width - Width) \ 2, ((Screen.Height - Height) \ 2 - 200)
  541.     'Initialize variables
  542.     NumSongsQueued = 0
  543.     Index = 0
  544.     TotalTime = "00:00:00"
  545.     label1.Caption = "Total Time: " + TotalTime
  546.     BTN_Play.Enabled = False
  547.     BTN_Next.Enabled = False
  548.     BTN_Pause.Enabled = False
  549.     BTN_Stop.Enabled = False
  550.     Screen.MousePointer = 11
  551.     File1.Pattern = "*.mid"
  552.     Me.Show
  553.     'Define the Carriage Return Line Feed
  554.     CRLF = Chr$(13) + Chr$(10)
  555.     'Determine if the MCIsequencer and Midi Mapper are installed
  556.     Result% = CanPlay()
  557.     Select Case Result%
  558.     Case 0
  559.         'Everything OK, continue with program
  560.     Case 1  'MCIsequencer not installed
  561.         Msg$ = "The MCI sequencer driver is not installed.  "
  562.         Msg$ = Msg$ + "This driver MUST be installed before you can use the player.  "
  563.         Msg$ = Msg$ + "See your Windows user guide for information on installing the MCI sequencer."
  564.         MsgBox Msg$, 16
  565.         End
  566.     Case 2  'Midi Mapper not installed
  567.         Msg$ = "The Midi Mapper is not installed.  "
  568.         Msg$ = Msg$ + "This driver MUST be installed before you can use the player.  "
  569.         Msg$ = Msg$ + "See your Windows user guide for information on installing the Midi Mapper."
  570.         MsgBox Msg$, 16
  571.         End
  572.     Case 3  'Neither is installed
  573.         Msg$ = "The MCIsequencer AND the Midi Mapper are not installed.  "
  574.         Msg$ = Msg$ + "These drivers MUST BOTH be installed before you can use the player.  "
  575.         Msg$ = Msg$ + "See your Windows user guide for information on installing these drivers."
  576.         MsgBox Msg$, 16
  577.         End
  578.     End Select
  579.     File1.SetFocus
  580.     Screen.MousePointer = 0
  581. End Sub
  582. Sub Form_Unload (Cancel As Integer)
  583.     'If SongPlaying Then
  584.     '    Cancel = True
  585.     '    Exit Sub
  586.     'End If
  587.     'Ensure any open devices are closed before exiting
  588.     Ret% = mciSendString("close all", 0&, 0, 0)
  589.     DoEvents
  590.     Erase SongPath
  591.     End
  592. End Sub
  593. Sub GetTime (Song As String)
  594.     'This sub retrieves the time of a single midi file
  595.     Dim Ret, ErrorRet As Integer
  596.     Dim mciErrorText As String
  597.     Dim mciBuffer As Integer
  598.     mciBuffer = 255
  599.     mciErrorText = Space(255)
  600.     MLen% = 255
  601.     Msg$ = String$(255, 0)
  602.     MMErr$ = String$(255, 0)
  603.     'Open the midi file
  604.     Ret = mciSendString("open " + Song + " type sequencer alias TimeInfo", 0&, 0, 0)
  605.     'Set the appropriate time format
  606.     Stat$ = "set TimeInfo time format smpte 30 drop"
  607.     Ret = mciSendString(Stat$, Msg$, MLen%, MidiPlayer.hWnd)
  608.     'Get the playing time of the opened midi file
  609.     Stat$ = "status TimeInfo length"
  610.     Ret = mciSendString(Stat$, Msg$, MLen%, MidiPlayer.hWnd)
  611.     If Ret <> 0 Then GoTo mciError5
  612.     'Trim the string down to just the needed info
  613.     SongLength = Mid$(Left$(Msg$, 11), 4, 5)
  614.     'If SongLength begins with a 0, eliminate it
  615.     If Left$(SongLength, 1) = "0" Then
  616.         SongLength = Mid$(SongLength, 2)
  617.     End If
  618.     'Call the Sub to accumulate the length of all songs queued
  619.     GetTotalTime
  620.     'Close the device
  621.     Ret = mciSendString("close all", 0&, 0, 0)
  622.     'Make sure Windows has processed all events
  623.     DoEvents
  624.     Exit Sub
  625. mciError5:
  626.     ErrorRet = mciGetErrorString(Ret, mciErrorText, mciBuffer)
  627.     If ErrorRet = 1 Then
  628.         Msg$ = mciErrorText
  629.         MsgBox Msg$, 48, "Midi Error"
  630.     Else
  631.         MsgBox "An unknown error occured", 16, "Error"
  632.     End If
  633.     Ret = mciSendString("close all", 0&, 0, 0)
  634. End Sub
  635. Sub GetTotalTime ()
  636.     'This sub accumulates the time of all songs as they are queued
  637.     On Error GoTo TimeError
  638.     ColonPosition = InStr(SongLength, ":")
  639.     Minutes = Val(Mid$(SongLength, 1, ColonPosition - 1))
  640.     'Seconds are converted to a decimal value
  641.     Seconds = Val(Mid$(SongLength, ColonPosition + 1)) / 60
  642.     SongTime = Minutes + Seconds
  643.     'Since TotalTime is used a variable elsewhere in the program,
  644.     'use TTime instead
  645.     TTime = TTime + SongTime
  646.     DecimalPosition = InStr(Trim$(Str$(TTime)), ".")
  647.     'If there's no decimal then seconds are 0, and ".00" must be appended
  648.     'to TT$
  649.     If DecimalPosition = 0 Then
  650.         'TT$ is the total time stored as a string
  651.         TT$ = Trim$(Str$(TTime)) + ".00"
  652.         DecimalPosition = InStr(TT$, ".")
  653.     Else
  654.         TT$ = Mid$(Trim$(Str$(TTime)), 1, DecimalPosition + 2)
  655.         If Len(Mid$(TT$, DecimalPosition + 1)) = 1 Then
  656.             TT$ = TT$ & "0"
  657.         End If
  658.     End If
  659.     'Convert the seconds from decimal back to standard time
  660.     Seconds = Val(Mid$(TT$, DecimalPosition + 1))
  661.     Seconds = Seconds * .6
  662.     'Find the position of the decimal point
  663.     SecsDecimalPos = InStr(Str$(Seconds), ".")
  664.     'Do some rounding off if necessary
  665.     If SecsDecimalPos > 0 Then
  666.         If Mid(Seconds, SecsDecimalPos, 1) > 5 Then
  667.             Seconds = Fix(Seconds)
  668.             Seconds = Seconds + 1
  669.         Else
  670.             Seconds = Fix(Seconds)
  671.         End If
  672.     End If
  673.     'Get the total number of minutes
  674.     Minutes = Val(Mid$(TT$, 1, DecimalPosition - 1))
  675.     'Compute the hours and the remaining minutes
  676.     Hours = Minutes \ 60
  677.     Minutes = Minutes - (Hours * 60)
  678.     'Convert each time unit to a string
  679.     Secs$ = Trim$(Str$(Seconds))
  680.     Mins$ = Trim$(Str$(Minutes))
  681.     Hrs$ = Trim$(Str$(Hours))
  682.     'If the number of seconds, minutes, or hours is a single digit,
  683.     'place a 0 in front
  684.     If Len(Secs$) = 1 Then
  685.         Secs$ = "0" + Secs$
  686.     End If
  687.     If Len(Mins$) = 1 Then
  688.         Mins$ = "0" + Mins$
  689.     End If
  690.     If Len(Hrs$) = 1 Then
  691.         Hrs$ = "0" + Hrs$
  692.     End If
  693.     'Create the total time string
  694.     TotalTime = Hrs$ + ":" + Mins$ + ":" + Secs$
  695.     Exit Sub
  696. TimeError:
  697.     Msg$ = "An error occurred while determining the time of the midi file.  "
  698.     Msg$ = Msg$ + "The program can continue, but the Total Time will not be accurate."
  699.     MsgBox Msg$, 48, "Non-Critical Error"
  700.     Resume Next
  701. End Sub
  702. Function IsSongQueued (SongQueued As String) As Integer
  703.     IsSongQueued = False
  704.     For I = 1 To NumSongsQueued - 1
  705.         If SongPath(I) = SongQueued Then
  706.             IsSongQueued = True
  707.             Exit For
  708.         End If
  709.     Next I
  710. End Function
  711. Sub MNU_About_Click ()
  712.     AboutBox.Show 1
  713. End Sub
  714. Sub MNU_Exit_Click ()
  715.     BTN_Exit_Click
  716. End Sub
  717. Sub MNU_MidiMap_Click ()
  718. On Error GoTo MidiMapErr
  719.     'Shell to the Midi Mapper
  720.     X% = Shell("control midi mapper", 1)
  721.     'Yield to Windows and disable the main form while
  722.     'the midi mapper is running.  This loop continues
  723.     'until the shelled app has been closed.
  724.     While GetModuleUsage(X%) > 0
  725.         z% = DoEvents()
  726.         MidiPlayer.Enabled = False
  727.     Wend
  728.     MidiPlayer.Enabled = True
  729.     MidiPlayer.SetFocus
  730.     Exit Sub
  731. MidiMapErr:
  732.     On Error GoTo 0
  733.     MsgBox "Could not start Midi Mapper", 16
  734.     Exit Sub
  735. End Sub
  736. Sub PlayList_DblClick ()
  737.     If SongPlaying Then Exit Sub
  738.     SelectedItemInList = PlayList.ListIndex
  739.     'Remove the highlighted item from the array
  740.     If SelectedItemInList + 1 = NumSongsQueued Then 'removing the last item in list
  741.         SongPath(NumSongsQueued) = ""
  742.     Else
  743.         'Move all entries in the list that follow the deleted entry
  744.         'up 1 in the array
  745.         For I = SelectedItemInList + 1 To NumSongsQueued - 1
  746.             SongPath(I) = SongPath(I + 1)
  747.         Next
  748.     End If
  749.     SubtractTime
  750.     label1.Caption = "Total Time: " + TotalTime
  751.     PlayList.RemoveItem SelectedItemInList
  752.     NumSongsQueued = PlayList.ListCount
  753.     If NumSongsQueued > 0 Then
  754.         'ReDim the array to equal the # of songs in the Play List
  755.         ReDim Preserve SongPath(NumSongsQueued)
  756.     Else
  757.         BTN_Play.Enabled = False
  758.         Erase SongPath
  759.         TTime = 0
  760.         TotalTime = "00:00:00"
  761.         label1.Caption = "Total Time: " + TotalTime
  762.     End If
  763. End Sub
  764. Sub SubtractTime ()
  765.     'This procedure is very similiar to GetTotalTime but it naturally
  766.     'subtracts the song's time instead of adding it
  767.     'Get the song's time from the entry in the play list
  768.     Tyme$ = Right$(PlayList.List(PlayList.ListIndex), 7)
  769.     ColonPosition = InStr(Tyme$, ":")
  770.     FirstParen = InStr(Tyme$, "(")
  771.     Minutes = Val(Mid$(Tyme$, FirstParen + 1, ColonPosition - FirstParen - 1))
  772.     Seconds = Val(Mid$(Tyme$, ColonPosition + 1, 2)) / 60
  773.     SongTime = Minutes + Seconds
  774.     TTime = TTime - SongTime
  775.     DecimalPosition = InStr(Trim$(Str$(TTime)), ".")
  776.     'If there's no decimal then seconds are 0, and ".00" must be appended
  777.     'to TT$
  778.     If DecimalPosition = 0 Then
  779.         TT$ = Trim$(Str$(TTime)) + ".00"
  780.         DecimalPosition = InStr(TT$, ".")
  781.     Else
  782.         TT$ = Mid$(Trim$(Str$(TTime)), 1, DecimalPosition + 2)
  783.         If Len(Mid$(TT$, DecimalPosition + 1)) = 1 Then
  784.             TT$ = TT$ & "0"
  785.         End If
  786.     End If
  787.     'Convert the seconds from decimal to the standard
  788.     'number of seconds
  789.     Seconds = Val(Mid$(TT$, DecimalPosition + 1))
  790.     Seconds = Seconds * .6
  791.     'If there is a decimal part to the seconds,
  792.     'round it off to the closest integer
  793.     SecsDecimalPos = InStr(Str$(Seconds), ".")
  794.     If SecsDecimalPos > 0 Then
  795.         If Mid(Seconds, SecsDecimalPos, 1) > 5 Then
  796.             Seconds = Fix(Seconds)
  797.             Seconds = Seconds + 1
  798.         Else
  799.             Seconds = Fix(Seconds)
  800.         End If
  801.     End If
  802.     'Get the total number of minutes
  803.     Minutes = Val(Mid$(TT$, 1, DecimalPosition - 1))
  804.     'Compute the hours and the remaining minutes
  805.     Hours = Minutes \ 60
  806.     Minutes = Minutes - (Hours * 60)
  807.     'Convert each time unit to a string
  808.     Secs$ = Trim$(Str$(Seconds))
  809.     Mins$ = Trim$(Str$(Minutes))
  810.     Hrs$ = Trim$(Str$(Hours))
  811.     'If the number of seconds, minutes, or hours is a single digit,
  812.     'place a 0 in front
  813.     If Len(Secs$) = 1 Then
  814.         Secs$ = "0" + Secs$
  815.     End If
  816.     If Len(Mins$) = 1 Then
  817.         Mins$ = "0" + Mins$
  818.     End If
  819.     If Len(Hrs$) = 1 Then
  820.         Hrs$ = "0" + Hrs$
  821.     End If
  822.     'Create the total time string
  823.     TotalTime = Hrs$ + ":" + Mins$ + ":" + Secs$
  824. End Sub
  825.